Const cGebizPath="\\192.168.83.34\gebiz"
'Const cGebizPath = "\\ncsfesg05\gebiz"
'Const cGebizPath = "\\Vegas\ncstore\ATLANTA\CRM\GeBiz Script - Bid Office\Testing"

Const cHttpLink = "http://gebiz.ncs.com.sg"

Const typeNameStr = "General"

Dim strSourcePath, oFSO, oSrcFolders, oDesFile, oFileName, strDesDrive, strDesFolder, oDesFolders, oDesWorkingFolder

'Get user folder where the files Gebiz files were downloaded
strSourcePath = GetUserInput()

If strSourcePath = "" Then
	MsgBox "You've not chosen the folder location of your Gebiz files, click OK to terminate the operation."
	WScript.Quit
End If

strDesDrive = MapFreeDrive(cGebizPath, False, Null, Null)

If IsNull(strDesDrive) Then
		MsgBox "Error accessing NCS Gebiz server"
		WScript.Quit
End If

Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
Set oSrcFolders = oFSO.GetFolder(strSourcePath)
Set oDesFolders = oFSO.GetFolder(strDesDrive) 

strDesFolder = InitializeDesFolder(oFSO, oSrcFolders, oDesFolders)
'strDesFolder =  InitializeTestFolder(oFSO, oSrcFolders, oDesFolders) ' For testing purpose only

Set oDesWorkingFolder = oFSO.GetFolder(strDesFolder)


Dim dateFolderNameStr
dateFolderNameStr=oDesWorkingFolder.ParentFolder.Name
Dim allSubFiles
Set allSubFiles=oSrcFolders.Files
Set objExcel = CreateObject("Excel.Application")
Set objWorkbook = objExcel.Workbooks.Add()
objExcel.Cells(1, 1).Value = "File Name"
objExcel.Cells(1, 1).Interior.ColorIndex = 6

Dim htmlFileNames
htmlFileNames=getHtmlFilesArr(allSubFiles)
'Dim htmlFileNamesLength
'htmlFileNamesLength=getFilesWithSurfixSize(allSubFiles,htmSurfixNames)
'Wscript.Echo htmlFileNamesLength
'ReDim htmlFileNames(htmlFileNamesLength-1)
'getFilesWithSurfix allSubFiles,htmSurfixNames,htmlFileNames


Dim line
line=2

Dim attachFileNameArray
For Each htmlFileName in htmlFileNames
    'Wscript.Echo "htmlFileName:" & htmlFileName
    
    'Dim dotPos
    'dotPos=InStr(htmlFileName,".")
    'Wscript.Echo dotPos
    Dim fileNamewithoutSurfix
    'fileNamewithoutSurfix=Mid(htmlFileName,1,(18-1))
	fileNamewithoutSurfix=GetFileName(htmlFileName)
    Dim folderName
    folderName=fileNamewithoutSurfix & "_files"
    'Wscript.Echo folderName

    'Wscript.Echo (typeFolder.Path & folderName)
	IF oFSO.FolderExists(oSrcFolders.Path & "\" & folderName) Then
		Set attachFilesFolder = oFSO.GetFolder(oSrcFolders.Path & "\" & folderName)
		Set attachFiles = attachFilesFolder.Files
		Dim gebizUrlPartial
		gebizUrlPartial=cHttpLink & "/" & dateFolderNameStr & "/" & typeNameStr & "/"
		
		objExcel.Cells(line, 1).Formula = "=HYPERLINK(" & """" & gebizUrlPartial & htmlFileName & """" & "," & """" & fileNamewithoutSurfix & """" & ")"
		
		
		

		attachFileNameArray=getAttachFilesArr(attachFiles)
		'Dim attachFileNamesLength
		'attachFileNamesLength=getFilesWithSurfixSize(attachFiles,attachSurfixNames)
		'Wscript.Echo attachFileNamesLength
		'ReDim attachFileNameArray(attachFileNamesLength-1)
		'getFilesWithSurfix attachFiles,attachSurfixNames,attachFileNameArray
		Dim count
		count=1 
		IF oFSO.FileExists(oSrcFolders.Path & "\" & fileNamewithoutSurfix & ".pdf") Then
		    Dim pdfFileName
			pdfFileName=fileNamewithoutSurfix & ".pdf"
			objExcel.Cells(1, count+1).Value = "Attachment " & count
			objExcel.Cells(1, count+1).Interior.ColorIndex = 6
			Set seCol=objExcel.Columns(count+1)
			seCol.ColumnWidth = 15
			With seCol
			'.HorizontalAlignment = xlGeneral
			'.VerticalAlignment = xlBottom
			.WrapText = True '!!!!!!!!!!!!!!!!!!!!!
			.Orientation = 0
			End With
			objExcel.Cells(line, count+1).Formula="=HYPERLINK(" & """" & gebizUrlPartial & pdfFileName & """" & "," & """" & pdfFileName & """" & ")"
			
		End If
		count=count+1
		For Each attachFileName in attachFileNameArray
			objExcel.Cells(1, count+1).Value = "Attachment " & count
			objExcel.Cells(1, count+1).Interior.ColorIndex = 6
			Set seCol=objExcel.Columns(count+1)
			seCol.ColumnWidth = 15
			With seCol
			'.HorizontalAlignment = xlGeneral
			'.VerticalAlignment = xlBottom
			.WrapText = True '!!!!!!!!!!!!!!!!!!!!!
			.Orientation = 0
			End With
			Dim s
			s="""" & gebizUrlPartial & """" & "," & """" & folderName & "/" & """" & "," & """" & attachFileName & """"
			objExcel.Cells(line, count+1).Formula="=HYPERLINK(CONCATENATE(" & s & ")," & """" & attachFileName & """" & ")"
			count=count+1
		Next
		line=line+1
	
	End If
    
   
    'objExcel.Cells(1, 1).Value = "Test value"
    'objExcel.Visible = True
Next

objWorkbook.SaveAs(strSourcePath & "\attachments" & FormatFolderName + ".xls")
objExcel.Quit

DisconnectNetworkDrive(strDesDrive)
MsgBox "Done, results can be found in " & strSourcePath & "\" & "attachments" & FormatFolderName + ".xls"


'**********************************************
' Function checks if file is a html file or not
' If yes true is returned, else false
'************************************************
Function IsHTML(strFileName)

	If Not(IsNull(FindString(1, ".htm", strFileName))) Then
		IsHTML = True
	ElseIf  Not(IsNull(FindString(1, ".html", strFileName))) Then
		IsHTML = True
	Else
		IsHTML = False
	End If


End Function

'**********************************************
' Function checks if file is a picture or script 
' attachment in a html file or not
' If yes true is returned, else false
'************************************************
Function IsHTMLComp(strName)

	Dim arrComp(15), i

	arrComp(0) = "2005_index_banner.jpg"
	arrComp(1) = "2005_logo_partner.gif"
	arrComp(2) = "arr_rgt2.gif"
	arrComp(3) = "clear.gif"
	arrComp(4) = "folder.gif"
	arrComp(5) = "header_tab_line.gif"
	arrComp(6) = "icon_howto.gif"
	arrComp(7) = "partner_2005.css"
	arrComp(8) = "singov_top_02.gif"
	arrComp(9) = "Thumbs.db"
	arrComp(10) = "treecollapsedMidNode.gif"
	arrComp(11) = "treeexpandedMidNode.gif"
	arrComp(12) = "treenoChildrenLastNode.gif"
	arrComp(13) = "treenoChildrenMidNode.gif"
	arrComp(14) = "treeverticalLine.gif"
	arrComp(15) = "logoSingGov1.gif"

	For i=0 to UBound(arrComp)
		If strName = arrComp(i) Then
			IsHTMLComp = True
			Exit For
		Else
			IsHTMLComp = False
		End If
	Next

End Function

'*************************************************************************
' Desc:	The function finds the string specified in strToFind. If its not found
'	Null is returned, else the first position where the string is found
'	is returned 
'*************************************************************************
Function FindString(intStart, strToFind, strSource)

	Dim intLast

	intLast = InStr(intStart, LCase(strSource), LCase(strToFind))

	If (intLast <= 0) Or IsNull(intLast) Then
		FindString = Null
	Else
		FindString = intLast
	End If

End Function

  '************************************************'
  'Desc:	The sub routine disconnects a network drive
  '		specified in strDrive
  '****************************************************
Sub DisconnectNetworkDrive(strDrive)
  
  	Dim oNet, oFSO
  
  	Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
    	
    	If oFSO.DriveExists(Left(strDrive,1)) Then
    	 	Set oNet = WScript.CreateObject("WScript.Network")
  		oNet.RemoveNetworkDrive strDrive
  	Else
  		Exit Sub
  	End If 
    
End Sub

'*******************************************
' Section for Subroutines and Functions
'*******************************************

'*******************************************
' Section for Subroutines and Functions
'*******************************************

'Creates folders, according to date, then copies files from source to destination
Function InitializeDesFolder(oFS, oSrcFolders, oDesFolders)

	Dim strDesParentFolderPath, strWorkingFolderName, oNewFolder, strDesWorkingFolderPath

	strDesParentFolderPath = oDesFolders.Path & FormatFolderName
	strDesWorkingFolderPath = strDesParentFolderPath & "\" & typeNameStr

	If Not(oFS.FolderExists(strDesParentFolderPath)) Then
		Set oNewFolder = oFS.CreateFolder(strDesParentFolderPath)
		Set oNewFolder = Nothing
	End If

	If Not(oFS.FolderExists(strDesWorkingFolderPath)) Then
		Set oNewFolder = oFS.CreateFolder(strDesWorkingFolderPath)
	End If

	oFS.CopyFile oSrcFolders.Path & "\*", strDesWorkingFolderPath & "\" , True
	oFS.CopyFolder oSrcFolders.Path & "\*", strDesWorkingFolderPath & "\" , True

	InitializeDesFolder = strDesWorkingFolderPath  

End Function


  '************************************************'
  'Desc:	The function returns maps a drive to the specified 
  '		network share. If strID (userID) and strPwd (Password)
  '		is Null the currently logged on credentials are used. 
  '		If bUpdateProfie is true the current profile is updated 
  '		else no update is done. 
  '		It returns the mapped drive. 
  '		A Null will be returned when an error occurs
  '****************************************************
  
Function MapFreeDrive(strUNC, bUpdateProfile, strID, strPwd)
  
  	Dim oFSO, oNet, strDrive

	On Error Resume Next
	
  	Set oFSO = WScript.CreateObject("Scripting.FileSystemObject")
  	Set oNet = WScript.CreateObject("WScript.Network")
  
  	strDrive = GetFreeDrive(oFSO)
   
  	If IsNull(strDrive) Then
  		MapFreeDrive = Null
  		Exit Function
  	End If
  
  	If IsNull(strID) or IsNull(strPwd) Then
  		oNet.MapNetworkDrive strDrive, strUNC, bUpdateProfile
  	Else
  		oNet.MapNetworkDrive strDrive, strUNC, bUpdateProfile, strID, strPwd
  	End If  
  
  	If Err.number <> 0 Then
  		MapFreeDrive = Null
  	Else
  		MapFreeDrive = strDrive
  	End If
  	
  	Set oFSO = Nothing
  	Set oNet = Nothing  
  
	On Error Goto 0
  
End Function

  '************************************************'
  'Desc:	The function returns a free drive that is unused
  '			A Null will be returned when an error occurs
  '****************************************************  
  
Function GetFreeDrive(ByRef oFS)
  
	Dim intDrive
  
	intDrive = 72 'Start with drive H:
		  
	Do While (intDrive <= 90)
	
		If oFS.DriveExists(Chr(intDrive)) Then
			intDrive = intDrive + 1
		Else
			GetFreeDrive = Chr(intDrive) & ":"
			Exit Function
		End If
	
	Loop 
	
	GetFreeDrive = Null
	  
End Function

'***************************************************************************
'Desc		The function returns a folder name, formated according to the  
'		current the date.
'***************************************************************************

Function FormatFolderName
  
	Dim strFileName
		
	If (Day(Date)< 10) Then
		strFileName = "0" & CStr(Day(Date))
	Else
		strFileName = CStr(Day(Date))
	End If
		
	If (Month(Date)< 10) Then
		strFileName = strFileName & "0" & CStr(Month(Date))
	Else
		strFileName = strFileName & CStr(Month(Date))
	End If
		
	strFileName = strFileName & Year(Date)
		
	FormatFolderName = strFileName
    
End Function

'Formats date in dd-mmmm-yyyy format
Function FormatDate(strDate)

	Dim dtmTemp, strNewDateFormat

	dtmTemp = DateValue(strDate)

	If (Day(dtmTemp)< 10) Then
		strNewDateFormat = "0" & CStr(Day(dtmTemp)) & "-"
	Else 
		strNewDateFormat = CStr(Day(dtmTemp)) & "-"
	End If

	strNewDateFormat = strNewDateFormat & CStr(MonthName(Month(dtmTemp), True)) & "-"
	strNewDateFormat = strNewDateFormat & CStr(Year(dtmTemp))

	FormatDate = strNewDateFormat


End Function

'Formats date in dd-mmmm-yyyy hh:mm:ss format
Function FormatDateTime(strDateTime)

	Dim strNewDateTime, intMarker, strOldFormat

	strOldFormat = Trim(strDateTime)

	intMarker = FindString(1, " ", strOldFormat)
	If IsNull(intMarker) Then
		FormatDateTime = ""
	Else
		strNewDateTime = " " & FormatDate(Mid(strOldFormat,1,intMarker-1))
		strNewDateTime = strNewDateTime & " " & Mid(strOldFormat, intMarker + 1, Len(strOldFormat))
		FormatDateTime = strNewDateTime
	End If



End Function

Function getAttachFilesArr(files)
    Dim length
	Dim arr()
    length=0
	ReDim arr(length)
    Dim objFileExtension
    For Each objFile in files
	    If Not(IsHTMLComp(objFile.Name)) Then
			If  length > 0 Then
					Dim tmpArr
					tmpArr=arr
					ReDim arr(length)
					For i=0 to (length-1)
						arr(i)=tmpArr(i)
					Next
				End If
				
				arr(length)=objFile.Name
                length=length+1
		End If
    Next
	getAttachFilesArr=arr
End Function

Function getHtmlFilesArr(files)
    Dim length
	Dim arr()
    length=0
	ReDim arr(length)
    For Each objFile in files
	    If IsHTML(objFile.Name) Then
			If  length > 0 Then
					Dim tmpArr
					tmpArr=arr
					ReDim arr(length)
					For i=0 to (length-1)
						arr(i)=tmpArr(i)
					Next
			End If
				
			arr(length)=objFile.Name
            length=length+1
		End If
    Next
	getHtmlFilesArr=arr
End Function

Function GetFileName(strName)
  
	Dim strTemp
  
	strTemp = Trim(strName)
	GetFileName = Mid(strTemp,1,InStrRev(strTemp, ".")-1)
	
End Function

'*************************************
'Get source folder from users
Function GetUserInput()

	Dim oDlg, oSourceFolder, oFolderItem

	Set oDlg = Wscript.CreateObject("Shell.Application")

	Set oSourceFolder = oDlg.BrowseForFolder(&H0, "Select the folder where Gebiz files were downloaded", &H0001)

	If InStr(1, TypeName(oSourceFolder), "Folder") > 0 Then
		Set oFolderItem = oSourceFolder.Self
		GetUserInput = oFolderItem.Path
	Else
		GetUserInput = ""
	End If

End Function